home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Tools / Languages / MacMETH 3.2.1 / Sources / MacC3.3 / M2TA.MOD < prev   
Encoding:
Text File  |  1992-05-29  |  10.1 KB  |  181 lines  |  [TEXT/MEDT]
  1. IMPLEMENTATION MODULE M2TA; (* NW 7.4.83; WH 10.1.86; HS 19.12.91 *)
  2.  
  3.   (* Implementation for the MOTOROLA 68000/68010/68020/68040 processors. *)
  4.  
  5.   FROM M2DA IMPORT
  6.        WordSize, NilVal, ObjPtr, Object, ObjClass, StrPtr, Structure, StrForm,
  7.        Standard, ParPtr, Parameter, PDesc, PDPtr, KeyPtr, Key,
  8.        mainmod, sysmod, MaxInt,
  9.        undftyp, cardtyp, inttyp, booltyp, chartyp, bitstyp,
  10.        realtyp, lrltyp, lwordtyp, dbltyp, proctyp, notyp, stringtyp,
  11.        addrtyp, bytetyp, wordtyp, ALLOCATE,^.left := ob1 ELSE ob0^.right := ob1 END;
  12.         ob1^.left := NIL; ob1^.right := NIL; ob1^.exported := FALSE;
  13.         IF (obj^.class = Typ) & (obj^.typ^.form = Enum) THEN
  14.           (*import enumeration constants too*)
  15.           ob0 := obj^.typ^.ConstLink;
  16.           WHILE ob0 # NIL DO
  17.             NewImp(scope, ob0); ob0 := ob0^.conval.prev
  18.           END
  19.         END;
  20.         EXIT
  21.       END
  22.     END
  23.   END NewImp;
  24.  
  25.   PROCEDURE NewPar(ident: INTEGER; isvar: BOOLEAN; last: ParPtr): ParPtr;
  26.     VAR par: ParPtr;
  27.   BEGIN ALLOCATE(par, SIZE(Parameter)); par^.name := ident;
  28.     par^.varpar := isvar; par^.next := last; RETURN par
  29.   END NewPar;
  30.  
  31.   PROCEDURE NewScope(cl: ObjClass);
  32.     VAR hd: ObjPtr;
  33.   BEGIN ALLOCATE(hd, SIZE(Object));
  34.     WITH hd^ DO
  35.       name := 0; typ := NIL; class := Header;
  36.       left := topScope; right := NIL; last := hd; next := NIL; kind := cl
  37.     END;
  38.     topScope := hd
  39.   END NewScope;
  40.  
  41.   PROCEDURE CloseScope;
  42.   BEGIN topScope := topScope^.left
  43.   END CloseScope;
  44.  
  45.   PROCEDURE CheckUDP(obj, node: ObjPtr);
  46.     (*obj is newly defined type; check for undefined forward references
  47.       pointing to this new type by traversing the tree*)
  48.   BEGIN
  49.     IF node # NIL THEN
  50.       IF (node^.class = Typ) & (node^.typ^.form = Pointer) &
  51.          (node^.typ^.PBaseTyp = undftyp) &
  52.          (Diff(node^.typ^.BaseId, obj^.name) = 0) THEN
  53.         node^.typ^.PBaseTyp := obj^.typ
  54.       END;
  55.       CheckUDP(obj, node^.left); CheckUDP(obj, node^.right)
  56.     END
  57.   END CheckUDP;
  58.  
  59.   PROCEDURE MarkHeap;
  60.   BEGIN ALLOCATE(topScope^.heap, 0); topScope^.name := id
  61.   END MarkHeap;
  62.  
  63.   PROCEDURE ReleaseHeap;
  64.   BEGIN ResetHeap(topScope^.heap); id := topScope^.name
  65.   END ReleaseHeap;
  66.  
  67.   PROCEDURE InitTableHandler;
  68.   BEGIN topScope := universe; mainmod^.firstObj := NIL; ReleaseHeap
  69.   END InitTableHandler;
  70.  
  71.   PROCEDURE EnterTyp(VAR str: StrPtr; name: ARRAY OF CHAR;
  72.                      frm: StrForm; sz: INTEGER);
  73.   BEGIN obj := NewObj(Enter(name), Typ); str := NewStr(frm);
  74.     obj^.typ := str; str^.strobj := obj; str^.size := sz;
  75.     obj^.exported := expo
  76.   END EnterTyp;
  77.  
  78.   PROCEDURE EnterProc(name: ARRAY OF CHAR; num: Standard; res: StrPtr);
  79.   BEGIN obj := NewObj(Enter(name), Code);
  80.     obj^.typ := res; obj^.std := num; obj^.exported := expo
  81.   END EnterProc;
  82.  
  83. BEGIN topScope := NIL; Scope := NIL;
  84.   NewScope(Module); universe := topScope;
  85.   undftyp := NewStr(Undef); undftyp^.size := 1;
  86.   notyp := NewStr(Undef); notyp^.size := 0;
  87.   stringtyp := NewStr(String); stringtyp^.size := 0;
  88.   BBtyp := NewStr(Range); (*Bitset Basetyp*)
  89.   ALLOCATE(mainmod, SIZE(Object));
  90.   WITH mainmod^ DO
  91.     class := Module; modno := 0; typ := notyp; next := NIL; exported := FALSE;
  92.     ALLOCATE(key, SIZE(Key))
  93.   END;
  94.  
  95.   (*initialization of Universe*)
  96.   expo := FALSE;
  97.   EnterTyp(booltyp,  "BOOLEAN",  Bool,     1);
  98.   EnterTyp(chartyp,  "CHAR",     Char,     1);
  99.   EnterTyp(inttyp,   "INTEGER",  Int,      2);
  100.   EnterTyp(cardtyp,  "CARDINAL", Range,    2);
  101.   EnterTyp(bitstyp,  "BITSET",   Set,      WordSize DIV 8);
  102.   EnterTyp(dbltyp,   "LONGINT",  Double,   4);
  103.   EnterTyp(realtyp,  "REAL",     Real,     4);
  104.   EnterTyp(lrltyp,   "LONGREAL", LongReal, 8);
  105.   EnterTyp(proctyp,  "PROC",     ProcTyp,  4);
  106.  
  107.   (*initialization of module SYSTEM*)
  108.   NewScope(Module);
  109.   expo := TRUE;
  110.   EnterTyp(bytetyp,  "BYTE",      Byte,  1);
  111.   EnterTyp(wordtyp,  "WORD",      Word,  2);
  112.   EnterTyp(lwordtyp, "LONGCARD",  LWord, 4);
  113.   EnterTyp(addrtyp,  "ADDRESS",   LWord, 4);
  114.   EnterProc('ADR',    Adr,    addrtyp);
  115.   EnterProc('TSIZE',  Tsize,  inttyp);
  116.   EnterProc('INLINE', Inline, notyp);
  117.   EnterProc('REG',    Reg,    dbltyp);
  118.   EnterProc('SETREG', Setreg, notyp);
  119.   EnterProc('ASH',    XAsh,   inttyp);
  120.   EnterProc('LSH',    XLsh,   inttyp);
  121.   EnterProc('MSK',    XMsk,   inttyp);
  122.   EnterProc('ROT',    XRot,   inttyp);
  123.   EnterProc('VAL',    Val,    inttyp);
  124.   EnterProc('LONG',   Long,   dbltyp);
  125.   EnterProc('SHORT',  Short,  inttyp);
  126.   EnterProc('Sqrt',   Sqrt,   realtyp);
  127.   EnterProc('Entier', Entier, dbltyp);
  128.   EnterProc('Round',  Round,  dbltyp);
  129.  
  130.   ALLOCATE(sysmod, SIZE(Object));
  131.   WITH sysmod^ DO
  132.     name := Enter("SYSTEM"); class := Module; modno := 0; exported := FALSE;
  133.     left := NIL; right := NIL; next := NIL;
  134.     firstObj := topScope^.right; root := topScope^.right;
  135.     ALLOCATE(key, SIZE(Key))
  136.   END;
  137.   CloseScope;
  138.  
  139.   (* initialization of Universe continued *)
  140.   expo := FALSE;
  141.  
  142.   obj := NewObj(Enter("FALSE"), Const);
  143.   obj^.typ := booltyp; obj^.conval.B := FALSE;
  144.   obj := NewObj(Enter("TRUE"), Const);
  145.   obj^.typ := booltyp; obj^.conval.B := TRUE;
  146.   obj := NewObj(Enter("NIL"), Const);
  147.   obj^.typ := addrtyp; obj^.conval.D := NilVal;
  148.   WITH cardtyp^ DO
  149.     RBaseTyp := inttyp; min := 0; max := MaxInt; size := 2;
  150.   END;
  151.   bitstyp^.SBaseTyp := BBtyp;
  152.   WITH BBtyp^ DO
  153.     RBaseTyp := inttyp; min := 0; max := WordSize - 1; size := 2;
  154.   END;
  155.   proctyp^.firstPar := NIL; proctyp^.resTyp := notyp;
  156.  
  157.   EnterProc('ABS',    Abs,    inttyp);
  158.   EnterProc('CAP',    Cap,    chartyp);
  159.   EnterProc('CHR',    Chr,    chartyp);
  160.   EnterProc('DEC',    Dec,    notyp);
  161.   EnterProc('EXCL',   Excl,   notyp);
  162.   EnterProc('FLOAT',  Float,  realtyp);
  163.   EnterProc('FLOATD', FloatD, lrltyp);
  164.   EnterProc('HALT',   Halt,   notyp);
  165.   EnterProc('HIGH',   High,   inttyp);
  166.   EnterProc('INC',    Inc,    notyp);
  167.   EnterProc('INCL',   Incl,   notyp);
  168.   EnterProc('LONG',   Long,   dbltyp);
  169.   EnterProc('MAX',    Max,    inttyp);
  170.   EnterProc('MIN',    Min,    inttyp);
  171.   EnterProc('ODD',    Odd,    booltyp);
  172.   EnterProc('ORD',    Ord,    inttyp);
  173.   EnterProc('SHORT',  Short,  inttyp);
  174.   EnterProc('SIZE',   Size,   inttyp);
  175.   EnterProc('TRUNC',  Trunc,  inttyp);
  176.   EnterProc('TRUNCD', TruncD, dbltyp);
  177.  
  178.   MarkHeap
  179.  
  180. END M2TA. (* Copyright Departement Informatik, ETH Zuerich, Switzerland, 1992 *)
  181.